home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyNoForceQuit.p < prev    next >
Encoding:
Text File  |  1996-05-31  |  2.2 KB  |  125 lines  |  [TEXT/CWIE]
  1. unit MyNoForceQuit;
  2.  
  3. interface
  4.  
  5.     procedure StartupNoForceQuit;
  6.  
  7. implementation
  8.  
  9.     uses
  10.         Types, Traps, OSUtils, Memory,
  11.         MyStartup;
  12.     
  13. {$PUSH}
  14. {$ALIGN MAC68K}
  15.  
  16.     type
  17.         JumpThruRecord = packed record
  18.             jump: UInt16;
  19.             addr: UniversalProcPtr;
  20.         end;
  21.         JumpThruRecordPtr = ^JumpThruRecord;
  22.  
  23. {$ALIGN RESET}
  24. {$POP}
  25.         
  26.     var
  27.         jumpthru: JumpThruRecordPtr;
  28.         oldsyserror: UniversalProcPtr;
  29.  
  30.     procedure AsmForceQuitStuff(oldaddr: UniversalProcPtr; var trapaddr: UniversalProcPtr); asm;
  31.     begin
  32.         lea    NoForceQuit, a0
  33.         move.l    4(sp), a1
  34.         move.l    a0, (a1)
  35.         move.l    8(sp), a0
  36.         lea    savedaddr, a1
  37.         move.l    a0, (a1)
  38.         rts
  39. NoForceQuit:
  40.         cmp.w    #20002,d0
  41.         beq.s    justreturn
  42.         move.l    savedaddr,a0
  43.         jmp    (a0)
  44. justreturn:
  45.         rts
  46. savedaddr:    ds.l    1
  47.     end;
  48.     
  49.     function InitNoForceQuit(var msg: integer): OSStatus;
  50.     begin
  51. {$unused(msg)}
  52.         oldsyserror := NGetTrapAddress(_SysError, ToolTrap);
  53.         jumpthru := JumpThruRecordPtr(NewPtrSys(SizeOf(JumpThruRecord)));
  54.         jumpthru^.jump := $4EF9;
  55.         AsmForceQuitStuff(oldsyserror, jumpthru^.addr);
  56.         FlushDataCache;
  57.         FlushInstructionCache;
  58.         NSetTrapAddress(UniversalProcPtr(jumpthru), _SysError, ToolTrap);
  59.         InitNoForceQuit := noErr;
  60.     end;
  61.  
  62.     procedure FinishNoForceQuit;
  63.     begin
  64.         jumpthru^.addr := oldsyserror;
  65.         FlushDataCache;
  66.         FlushInstructionCache;
  67.     end;
  68.  
  69.     procedure StartupNoForceQuit;
  70.     begin
  71.         SetStartup(InitNoForceQuit, nil, 0, FinishNoForceQuit);
  72.     end;
  73.     
  74. end.
  75.     function MyGetTrapAddress (trapword: integer): UniversalProcPtr;
  76.     begin
  77.         MyGetTrapAddress := UniversalProcPtr(NGetTrapAddress(trapword, TrapType(TPbtst(trapword, 11))));
  78.     end;
  79.  
  80.     procedure MySetTrapAddress (addr: UniversalProcPtr; trapword: integer);
  81.     begin
  82.         NSetTrapAddress(addr, trapword, TrapType(TPbtst(trapword, 11)));
  83.     end;
  84.  
  85.     include    'sysequ.a'
  86.     include    'traps.a'
  87.     proc    
  88.     export    AsmInitNoForceQuit, NoForceQuit
  89.  
  90. ; procedure AsmInitNoForceQuit(sys6byte:Ptr; oldsyserror:Ptr);
  91. AsmInitNoForceQuit
  92.     lea    data,a1
  93.     move.l    4(sp),0(a1)
  94.     move.l    8(sp),a0
  95.     move.l    a0,4(a1)
  96.     move.w    #$4EF9,(a0)
  97.     lea    NoForceQuit,a1
  98.     move.l    a1,2(a0)    
  99.  
  100.     _FlushDataCache
  101.     _FlushInstructionCache
  102.  
  103.     move.l    (sp)+,a0
  104.     add.l    #8,sp
  105.     jmp    (a0)
  106.     
  107. ; D0.w = error
  108. NoForceQuit
  109.     cmp.w    #20002,d0
  110.     beq.s    justreturn
  111.     move.l    oldaddr,a0
  112.     jmp    (a0)
  113. justreturn
  114.     rts
  115.  
  116. data
  117. oldaddr    ds.l    1
  118. sysptr    ds.l    1
  119.  
  120.     endp
  121.  
  122.     end
  123.     
  124. asm -wb "{active}"
  125.